          SUBROUTINE (PASSER)
** Version# 26.0001[6] - 10/28/2014 - 02:26pm - TSMITH - eclipse
*** V26.0001 Change - Custom Coding . - 10/28/2014 - TSMITH - eclipse

*** Subroutine : RENTAL.PROD.MAINT
*-------------------------------------------------------------------------*
*** This is the routine that actually updates a serial number specific
*** rental product
*-------------------------------------------------------------------------*
*** Parameters:
*** NONE
*-------------------------------------------------------------------------*
*** Globals:
*** PRD  - Product
*** PRDD - Prod Dynam
*-------------------------------------------------------------------------*

          CHECK.KEY 'RENTAL.MAINT',ENTRY.OK,LEVEL
          CHECK.KEY 'COGS.VIEW'   ,COGS.VIEW

          IF NOT(ENTRY.OK) THEN RETURN

          DIM RENT(50)

          READ VSTATS FROM CTRLFILE,'RENTAL.PROD.STATUS' ELSE VSTATS = ''

          SCREEN
*          UT.SEC3 23,AUTH.OK,,YES
          AUTH.OK = YES
          IF AUTH.OK # YES AND USER.ID # 'TSMITH' THEN GOTO FINISH

          RETIRED.ID    = ""
          FIRST.RETIRED = NO

          RPN       = PASSER<1>
          VIEW.ONLY = PASSER<2>

          IF LEVEL < 2 THEN VIEW.ONLY = YES
*-------------------------------------------------------------------------*
START:    CLEAR.SCREEN
          MENU.CLEAR

          MAT RENT   = ''
          ORENT      = ''
          STAT       = ''
          BR         = ''
          OBR        = ''
          LOC        = ''
          IS.RENTED  = ''
          IS.RETIRED = ''
          DESC       = ''
          WP.INFO$   = ''
*-------------------------------------------------------------------------*
          IF PASSER<1> = '' AND RETIRED.ID = '' THEN
             RPN.VERF = 'S:VERF.RENTAL.PRODUCT'
             IF NOT(VIEW.ONLY) AND NOT(IS.RETIRED) AND (LEVEL > 2) THEN
                RPN.VERF := ',New'
             END

IN.RPN:      INP RPN,13,1,20,V_RPN.VERF
             IF QUIT THEN GOTO FINISH
             IF RPN = '' THEN PRINT BELL:; GOTO IN.RPN
          END

          RETIRED.ID = ""

          IF (OCONV(RPN,'MCU') = 'NEW' OR NEW) AND NOT(VIEW.ONLY) AND NOT(IS.RETIRED) THEN
             GOSUB GET.NEW.ID
          END

          GOSUB GET.ID
          GOSUB DISPLAY
          GOSUB HKEYS

          IF VIEW.ONLY OR IS.RENTED OR IS.RETIRED OR LEVEL < 3 THEN GOTO IN.VIEW

          GOTO INDESC
*-------------------------------------------------------------------------*
IN.PN:
          OLD.PN = RENT(1)
IN$$1:    INP RENT(1),2,3,30,'TPRODUCT;X;1;1',V_'S:VERF.PRD.ID'
          *** check to see if this is a lot item.
          READV STATUS FROM PRDFILE,RENT(1),3 ELSE STATUS = ''
             IF STATUS = 9 THEN
                MESS 4,7,'Product cannot be a Lot Item!'
                RENT(1) = OLD.PN
                PRINT @( 2, 3):DESC<1,1>               "L#30"
                PRINT @( 2, 4):DESC<1,2>               "L#30"
                PRINT @( 2, 5):DESC<1,3>               "L#30"
                GOTO IN.PN
             END
          IF QUIT THEN GOSUB FILEIT

          IF CHANGED THEN
             READV STATUS FROM PRDFILE,RENT(1),3 ELSE STATUS = ''
             IF STATUS = 9 THEN
                MESS 4,7,'Product cannot be a Lot Item!'
                RENT(1) = OLD.PN
                PRINT @( 2, 3):DESC<1,1>               "L#30"
                PRINT @( 2, 4):DESC<1,2>               "L#30"
                PRINT @( 2, 5):DESC<1,3>               "L#30"
                GOTO IN.PN
             END
             READV DESC FROM PRDFILE,RENT(1),1 ELSE DESC = ''
             GOSUB DISPLAY
          END

          ON MOVE+1 GOTO IN.PN,IN.PN,IN.PN,IN.PN
*-------------------------------------------------------------------------*
INDESC:   INPWP RENT(6),2,7,30,2,99,'0101','RENTAL.PROD.MAINT~INDESC'
          IF QUIT THEN GOSUB FILEIT
          ON MOVE+1 GOTO INDESC,INDESC,IN.PN,INDESC
*-------------------------------------------------------------------------*
INSTAT:   INP STAT,2,10,17,V_'D:':VSTATS
          IF STAT = 'Retired' THEN
             PRINT BELL:;
             ERR.MESS 2,5,'You Must use the Retire Hotkey'
             GOTO INSTAT
          END

          IF QUIT THEN GOSUB FILEIT
          ON MOVE+1 GOTO INSTAT,INSTAT,INDESC,INBR,INSER,INBR
*-------------------------------------------------------------------------*
INBR:     INP.BR 22,10,4,BR,,,NO,NO
          IF QUIT THEN GOSUB FILEIT
          ON MOVE+1 GOTO INBR,INSTAT,INDESC,INBR,INLOC,INSER
*-------------------------------------------------------------------------*
INSER:    INP RENT(5),2,12,17
          IF QUIT THEN GOSUB FILEIT
          ON MOVE+1 GOTO INSER,INSER,INSTAT,INLOC,INDEP,INLOC
*-------------------------------------------------------------------------*
INLOC:    INP LOC,22,12,12
          IF QUIT THEN GOSUB FILEIT
          ON MOVE+1 GOTO INLOC,INSER,INBR,INLOC,INPERC,INDEP
*-------------------------------------------------------------------------*
INDEP:    INP RENT(11),2,14,5,'R2'
          IF QUIT THEN GOSUB FILEIT
          ON MOVE+1 GOTO INDEP,INDEP,INSER,INPERC,INCOST,INPERC
*-------------------------------------------------------------------------*
INPERC:   INP RENT(13),22,14,6,'R26'
          IF QUIT THEN GOSUB FILEIT
          ON MOVE+1 GOTO INPERC,INDEP,INLOC,INPERC,INDT,INCOST
*-------------------------------------------------------------------------*
INCOST:   INP RENT(3),2,16,17,'R3'
          IF NOT(RENT(12)) THEN
             PRINT @( 2,18):OCONV(RENT(3),'MR23')    "R2#17"
          END
          IF QUIT THEN GOSUB FILEIT
          ON MOVE+1 GOTO INCOST,INCOST,INDEP,INDT,INCOST,INCOST
*-------------------------------------------------------------------------*
INDT:     INP RENT(2),22,16,10,'D4/'
          IF QUIT THEN GOSUB FILEIT
          ON MOVE+1 GOTO INDT,INCOST,INPERC,INDT,INDT,INDT
*-------------------------------------------------------------------------*
IN.VIEW:  *
IN$$2:    INP ,0,0,0
          IF QUIT THEN
             IF PASSER<1> THEN
                GOTO FINISH
             END ELSE
                GOTO START
             END
          END
          GOTO IN.VIEW
*-------------------------------------------------------------------------*
SUBS:     ON OPTION GOTO LOG.VIEW,LOG.CMT,RATES,RETIRE,VIEW,PRODS
          RETURN
*-------------------------------------------------------------------------*
LOG.VIEW: MAINT.LOG.VIEW 'PRODUCT.RENTAL':AM:RPN:AM:RPN
          RETURN
*-------------------------------------------------------------------------*
LOG.CMT:  *
          IF VIEW.ONLY THEN PRINT BELL:; RETURN
          RENTAL.PROD.CMT RPN

          RETURN
*-------------------------------------------------------------------------*
RATES:    *
          RRSHEET.MAINT RENT(1),VIEW.ONLY

          RETURN
*-------------------------------------------------------------------------*
RETIRE:   *
          IF VIEW.ONLY THEN PRINT BELL:; RETURN
          IF LEVEL < 4 THEN PRINT BELL:; RETURN

          IF STAT = 'Rented' THEN
             PRINT BELL:;
             OMSG = 'You Cannot Retire An Item':AM
             OMSG:= 'That Is Currently Rented.'
             ERR.MESS 2,5,OMSG
             RETURN
          END

          PN = RENT(1)
          RENTAL.PROD.MAINT.RETIRE RPN,PN,MAT RENT

          IF RENT(8) AND NOT(FIRST.RETIRED) THEN
             LOCATE RPN IN PRDD.BR(25)<1> SETTING POS THEN
                STAT = "Retired"
                LOC  = ""
                IS.RETIRED = YES
                RETIRED.ID = RPN
                GOTO FILEIT
             END
          END

          RETURN
*-------------------------------------------------------------------------*
VIEW:     *
          IF NOT(IS.RENTED) THEN PRINT BELL:;RETURN
          RENTAL.OE.COMMON LOC,1,YES

          RETURN
*-------------------------------------------------------------------------*
PRODS:    * Recommended Products to be sold with the rental product
          RENTAL.PROD.SALES RPN
          RETURN
*-------------------------------------------------------------------------*
DISPLAY:  *
          BEGIN CASE
          CASE IS.RETIRED
             PRINT @(27,0):BLINK$:'*Retired*':NORM$
          CASE VIEW.ONLY OR IS.RENTED
             PRINT @(25,0):BLINK$:'*View Only*':NORM$
          END CASE

          PRINT @(13, 1):RPN                     "L#20"

          PRINT @( 2, 3):DESC<1,1>               "L#30"
          PRINT @( 2, 4):DESC<1,2>               "L#30"
          PRINT @( 2, 5):DESC<1,3>               "L#30"

          PRINT @( 2, 7):RENT(6)<1,1>            "L#30"
          PRINT @( 2, 8):RENT(6)<1,2>            "L#30"

          PRINT @( 2,10):STAT                    "L#17"
          PRINT @(22,10):BR                      "L#4"
          PRINT @( 2,12):RENT(5)                 "L#17"

          IF IS.RENTED THEN
             PRINT @(22,12):BLINK$:'**':LOC "L#8":'**':NORM$
          END ELSE
             PRINT @(22,12):LOC                  "L#12"
          END

          PRINT @( 2,14):OCONV(RENT(11),'MR2')   "R2#5"
          IF RENT(13) # '' THEN
             PRINT @(22,14):OCONV(RENT(13),'MR2')   "R2#5"
          END
          PRINT @(22,16):OCONV(RENT(2),'D4/')    "L#10"

          IF RENT(12) THEN
             O.VAL = ICONV(OCONV(RENT(3),'MR3'),'MR2')
             DEP.TO.DT = O.VAL - RENT(12)
             PRINT @( 2,18):OCONV(RENT(12),'MR2')    "R2#17"
          END ELSE
             PRINT @( 2,18):OCONV(RENT(3),'MR23')    "R2#17"
             DEP.TO.DT = 0
          END
          PRINT @( 22,18):OCONV(DEP.TO.DT,'MR2')   "R2#17"

          IF COGS.VIEW THEN
             PRINT @(1,15):'Original Cost'
             PRINT @(2,16):OCONV(RENT(3),'MR3')    "R3#17"
          END

          RETURN
*-------------------------------------------------------------------------*
HKEYS:    *
          MENU.LOAD  2,20,3,3,'G'

          IF NOT(IS.RETIRED) THEN
             MENU.LOAD 14,20,3,1,'C'
             MENU.LOAD 20,20,5,3,'T'
          END ELSE
             MENU.LOAD
             MENU.LOAD
          END

          IF (LEVEL > 3) THEN
             MENU.LOAD 28,20,6,1,'R'
          END ELSE
             MENU.LOAD
          END

          IF IS.RENTED THEN
             PRINT @(25,21):'':
             PRINT @(25,22):'View ':
             PRINT @(25,23):'':

             MENU.LOAD 25,22,4,1,'V'
          END ELSE
             MENU.LOAD
          END

          IF NOT(IS.RETIRED) THEN
             MENU.LOAD  2,22,20,13,'P'
          END ELSE
             MENU.LOAD
          END

          RETURN
*-------------------------------------------------------------------------*
GET.NEW.ID:  *
          IF OCONV(RPN,'MCU') = 'NEW' THEN RPN = ''
          IF RPN[1,1] = 'R'           THEN RPN = RPN[2,LEN(RPN) - 1]
          IF NOT(NUM(RPN))            THEN RPN = ''

          FPN = ''
          TPN = ''
          BR  = ''
          LOC = ''

          RENTAL.PROD.MAINT.NEW RPN,FPN,TPN,BR,LOC
          IF NOT(RPN) THEN PRINT BELL:; RETURN TO IN.RPN

          RENTAL.PROD.CREATE RPN,FPN,BR,1,LOC,RERR
          IF RERR THEN RETURN TO ID.ERR

          IF TPN THEN
             RENTAL.PROD.CONV RPN,FPN,TPN,BR,RERR
             IF RERR THEN RETURN TO ID.ERR

             READ NRNT FROM RENTFILE,RPN THEN
                ORNT    = NRNT
                NRNT<1> = TPN
                TREASON = REASON$
                REASON$ = '**'
                UPDATE.RECORD 'PRODUCT.RENTAL',RENTFILE,RPN,ORNT,NRNT,RERR
                RELEASE RENTFILE,RPN
                IF RERR THEN RETURN TO ID.ERR
                REASON$ = TREASON
             END
          END

          RETURN
*-------------------------------------------------------------------------*
GET.ID:   *
          MATREAD RENT FROM RENTFILE,RPN ELSE
             RERR = 'Cannot read ':RPN:' from PRODUCT.RENTAL.'
             RETURN TO ID.ERR
          END
          MATBUILD ORENT FROM RENT

          IF BR = '' THEN
             *** If the branch isn't filled in at the rental level,
             *** then it is assumed that this rental hasn't been
             *** edited since the branch and retired flags were moved
             *** into the rental record. Therefore, they need to be
             *** searched for in the PRDD record. Note, there is a
             *** problem in that if the rental product is retired
             *** before the branch was set in the rental record, this
             *** search will always happen.

             PRDD.BR.GET.BRS RENT(1),BRS
             BR.CT = DCOUNT(BRS,AM)

             OCC = 1

             FOR BRX = 1 TO BR.CT
                PRDD.BR.GET.VAL BRS<BRX>,RENT(1),25,RPNS

                PN.CT = DCOUNT(RPNS,VM)
                FOR RNX = 1 TO PN.CT
                   IF RPNS<1,RNX> = RPN THEN
                      BR = BRS<BRX>
                      GOTO FOUND.BR
                   END
                NEXT PNX
             NEXT BRX
FOUND.BR:    *
             IF BR = '' THEN
                IS.RETIRED = YES
             END

             RENT(7)  = BR
             ORENT<7> = BR

             MATWRITE RENT ON RENTFILE,RPN
          END

          PRDD.BR.GET BR,RENT(1)
          LOCATE RPN IN PRDD.BR(25)<1> SETTING POS THEN
             LOC  = PRDD.BR(27)<1,POS,1>
             STAT = PRDD.BR(26)<1,POS>
             IF NOT(NUM(STAT)) THEN STAT = 1
             STAT = VSTATS<1,STAT>

             BEGIN CASE
             CASE STAT = "Rented"
                LOC = FIELD(LOC,'.',1)
                IS.RENTED = YES
             CASE STAT = "Retired"
                IS.RETIRED    = YES
                FIRST.RETIRED = YES
             END CASE
          END ELSE
             *** Theoretically, IS.RETIRED should already be YES if we
             *** hit this clause anyway...
             IS.RETIRED    = YES
             FIRST.RETIRED = YES
          END

          IF IS.RETIRED THEN
             STAT = 'Retired'
             LOC  = ''
          END

          OBR = BR

          READV DESC FROM PRDFILE,RENT(1),1 ELSE DESC = '** Not Found **'

          RETURN
*-------------------------------------------------------------------------*
ID.ERR:   INP.PROMPT ,RERR,,0
          IF PASSER<1> THEN GOTO FINISH
          GOTO START
*-------------------------------------------------------------------------*
FILEIT:   *
          IF F12 THEN
             CONFIRM.ABORT SURE
             IF NOT(SURE) THEN RETURN

             IF PASSER<1> THEN RETURN TO FINISH
             RETURN TO START
          END

          IF (VIEW.ONLY) OR (FIRST.RETIRED) THEN GOTO SKIP.UPD

          IF ORENT<1> # RENT(1) THEN
             RENTAL.PROD.CONV RPN,ORENT<1>,RENT(1),BR,RERR
             IF RERR THEN GOTO FILE.ERR
          END

          MATBUILD NRENT FROM RENT

          UPDATE.RECORD 'PRODUCT.RENTAL',RENTFILE,RPN,ORENT,NRENT,RERR
          RELEASE RENTFILE,RPN
          IF RERR THEN GOTO FILE.ERR

          ** Update PROD.DYNAM
          IF OBR # BR THEN
             *** If the branch changed, first remove it from the
             *** old branch.
             PRDD.BR.LOCK OBR,RENT(1)
             PRDD.BR.GET  OBR,RENT(1)

             LOCATE RPN IN PRDD.BR(25)<1> SETTING POS THEN
                PRDD.BR(25) = DELETE(PRDD.BR(25),1,POS)
                PRDD.BR(26) = DELETE(PRDD.BR(26),1,POS)
                PRDD.BR(27) = DELETE(PRDD.BR(27),1,POS)
                PRDD.BR(28) = DELETE(PRDD.BR(28),1,POS)
             END

             PRDD.BR.WRITE  OBR,RENT(1)
             PRDD.BR.UNLOCK OBR,RENT(1)
          END

          PRDD.BR.LOCK BR,RENT(1)
          PRDD.BR.GET  BR,RENT(1)

          LOCATE RPN IN PRDD.BR(25)<1> SETTING POS ELSE NULL

          LOCATE STAT IN VSTATS<1> SETTING S ELSE S = 1
          STAT = S

          PRDD.BR(25)<1,POS> = RPN
          PRDD.BR(26)<1,POS> = STAT
          PRDD.BR(27)<1,POS> = LOC
          PRDD.BR(28)<1,POS> = ''

          PRDD.BR.WRITE  BR,RENT(1)
          PRDD.BR.UNLOCK BR,RENT(1)

SKIP.UPD: *** Skip the update if this is view only or retired
          IF PASSER<1> THEN RETURN TO FINISH
          RETURN TO START
*-------------------------------------------------------------------------*
FILE.ERR: INP.PROMPT ,RERR,,0
          RETURN
*-------------------------------------------------------------------------*
FINISH:   WINDOW.CLOSE
          RETURN
*-------------------------------------------------------------------------*
!TSMITH~10/28/14~14:26
